home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / minicaml / eval.ml < prev    next >
Text File  |  1995-06-01  |  3KB  |  85 lines
  1. #open "syntaxe";;
  2.  
  3. exception Échec_filtrage;;
  4.  
  5. let rec filtrage valeur motif =
  6.   match (valeur, motif) with
  7.     (val, Motif_variable id) -> [id, val]
  8.   | (Val_booléenne b1, Motif_booléen b2) ->
  9.       if b1 = b2 then [] else raise Échec_filtrage
  10.   | (Val_nombre i1, Motif_nombre i2) ->
  11.       if i1 = i2 then [] else raise Échec_filtrage
  12.   | (Val_paire(v1, v2), Motif_paire(m1, m2)) ->
  13.       filtrage v1 m1 @ filtrage v2 m2
  14.   | (Val_nil, Motif_nil) -> []
  15.   | (Val_cons(v1, v2), Motif_cons(m1, m2)) ->
  16.       filtrage v1 m1 @ filtrage v2 m2
  17.   | (_, _) -> raise Échec_filtrage;;
  18. let rec évalue env expr =
  19.   match expr with
  20.     Variable id ->
  21.       begin try
  22.         assoc id env
  23.       with Not_found -> raise(Erreur(id ^ " est inconnu"))
  24.       end
  25.   | Fonction(liste_de_cas) ->
  26.       Val_fermeture {Définition = liste_de_cas; Environnement = env}
  27.   | Application(fonction, argument) ->
  28.       let val_fonction = évalue env fonction in
  29.       let val_argument = évalue env argument in
  30.       begin match val_fonction with
  31.         Val_primitive fonction_primitive ->
  32.           fonction_primitive val_argument
  33.       | Val_fermeture fermeture ->
  34.           évalue_application fermeture.Environnement
  35.                              fermeture.Définition val_argument
  36.       | _ ->
  37.           raise(Erreur "application d'une valeur non fonctionnelle")
  38.       end
  39.   | Let(définition, corps) ->
  40.       évalue (évalue_définition env définition) corps
  41.   | Booléen b -> Val_booléenne b
  42.   | Nombre n -> Val_nombre n
  43.   | Paire(e1, e2) -> Val_paire(évalue env e1, évalue env e2)
  44.   | Nil -> Val_nil
  45.   | Cons(e1, e2) -> Val_cons(évalue env e1, évalue env e2)
  46.  
  47. and évalue_application env liste_de_cas argument =
  48.   match liste_de_cas with
  49.     [] -> raise(Erreur "échec du filtrage")
  50.   | (motif, expr) :: autres_cas ->
  51.       try
  52.         let env_étendu = filtrage argument motif @ env in
  53.         évalue env_étendu expr
  54.       with Échec_filtrage ->
  55.         évalue_application env autres_cas argument
  56.  
  57. and évalue_définition env_courant déf =
  58.   match déf.Récursive with
  59.     false -> (déf.Nom, évalue env_courant déf.Expr) :: env_courant
  60.   | true ->
  61.       match déf.Expr with
  62.         Fonction liste_de_cas ->
  63.           let fermeture =
  64.             { Définition = liste_de_cas; Environnement = [] } in
  65.           let env_étendu =
  66.             (déf.Nom, Val_fermeture fermeture) :: env_courant in
  67.           fermeture.Environnement <- env_étendu;
  68.           env_étendu
  69.       | _ -> raise(Erreur "let rec non fonctionnel");;
  70. let rec imprime_valeur = function
  71.     Val_nombre n -> print_int n
  72.   | Val_booléenne false -> print_string "false"
  73.   | Val_booléenne true -> print_string "true"
  74.   | Val_paire(v1, v2) ->
  75.       print_string "("; imprime_valeur v1;
  76.       print_string ", "; imprime_valeur v2;
  77.       print_string ")"
  78.   | Val_nil ->
  79.       print_string "[]"
  80.   | Val_cons(v1, v2) ->
  81.       imprime_valeur v1;
  82.       print_string "::"; imprime_valeur v2
  83.   | Val_fermeture _ | Val_primitive _ ->
  84.       print_string "<fun>";;
  85.